;;########################################################################
;; visuals.lsp 
;; copyright (c) 1991-98 by Forrest W. Young
;; Contains code for the Visuals guided tour spreadplot.
;;########################################################################

;(set-working-directory *code-dir-name*)
;(require "vista")
;(require "sprdsize")
;(require "tourplot")

;;########################################################################
;;define visuals guided tour spreadplot
;;########################################################################

(defun visuals (vars point-labels var-labels model-p &key scale-type targets)
"Args: (variables point-labels variables-labels model-p &key scale-type)
When more than six variables, displays a guided tour consisting of a scatterplot-matrix, high-dimensional spin-plot, and two 3d spin-plots.  Returns an error message when less than six variables.  When more than nine variables uses only first nine.  Each plot is formed from VARIABLES, and uses POINT-LABLES and VARIABLE-LABELS.  TARGETS is T to display targets initially. MODEL-P is t when creating a guided tour of a model, nil for guided tours of data (no model). ScALE-TYPE can be nil, fixed or variable.  These work as described for other plots."
  (send *watcher* :write-text "Creating Visuals" :show t)
(let ((nvar (length vars))
      (variables vars)
      (variable-labels var-labels))
 ; (when (> nvar 9)
 ;       (setf nvar 9)
 ;       (setf variables (select variables (iseq 9)))
 ;       (setf variable-labels (select variable-labels (iseq 9)))
 ;       (error-message "Too many variables for Guided Tour. The first 9 are used."))
  (if (< nvar 6)
      (too-few)
      (send tour-spreadplot-proto 
            :new variables point-labels variable-labels model-p 
            scale-type nvar targets))))

(defun too-few ()
  (error-message (format nil 
     "Too few variables for Guided Tour.  There must be at least 6.")))

(defproto tour-spreadplot-proto 
  '(plot-objs basic-width basic-height list-width targets title))

(defmeth tour-spreadplot-proto :plot-objs (&optional (arg nil set))
"List of plot objects."
  (if set (setf (slot-value 'plot-objs) arg))
  (slot-value 'plot-objs))

(defmeth tour-spreadplot-proto :basic-width (&optional (arg nil set))
"Basic width of a plot-window."
  (if set (setf (slot-value 'basic-width) arg))
  (slot-value 'basic-width))

(defmeth tour-spreadplot-proto :basic-height (&optional (arg nil set))
"Basic height of a plot-window."
  (if set (setf (slot-value 'basic-height) arg))
  (slot-value 'basic-height))

(defmeth tour-spreadplot-proto :list-width (&optional (arg nil set))
"Width of a name list window"
  (if set (setf (slot-value 'list-width) arg))
  (slot-value 'list-width))

(defmeth tour-spreadplot-proto :targets (&optional (arg nil set))
"T if Target windows showing, nil otherwise."
  (if set (setf (slot-value 'targets) arg))
  (slot-value 'targets))

(defmeth tour-spreadplot-proto :title (&optional (arg nil set))
  (if set (setf (slot-value 'title) arg))
  (slot-value 'title))

(defmeth tour-spreadplot-proto :new  
  (variables point-labels variable-labels model-p scale-type nvar targets)
"Args: (variables point-labels variables-labels scale-type nvar targets)
Used by the visuals function to display the visuals guided tour spreadplot."
  (let* (
         (var-indices (if (> nvar 6)
                          (combine '(0 1 4 2 3 5) (iseq 6 (- nvar 1)))
                          '(0 1 4 2 3 5)))
         (permuted-variables (select variables var-indices))
         (permuted-variable-labels (select variable-labels var-indices))
         (list-width 100)
         (max-size nil) (basic-size nil) (basic-height nil) 
         (basic-width  nil) 
         (ntimes nil)
         (send self :title "Guided Tour Plot")
         (tour-plot (tour-plot permuted-variables
                :show nil
                :scale-type scale-type
                :title "Guided Tour"
                :point-labels point-labels
                :variable-labels permuted-variable-labels))
         (target1 (spin-plot permuted-variables
                :show nil
                :scale-type scale-type
                :title "First Target"
                :point-labels point-labels
                :variable-labels permuted-variable-labels))
         (target2 (spin-plot permuted-variables
               :show nil
               :scale-type scale-type
               :title "Second Target"    
               :point-labels point-labels
               :variable-labels permuted-variable-labels))
         (obs-list 
               (name-list point-labels :title "Obs" :show nil))
         (var-list 
               (name-list variable-labels :title "Var" :show nil))
         (targets nil)
         (junk (send *watcher* :write-text "Creating SpreadPlot" :show t))
         (splot (if targets
                    (spread-plot (matrix '(2 3) 
                         (list tour-plot target1 
                               (list var-list obs-list ) nil target2 nil))
                                 :rel-widths '(2 1 .5 )
                                 :span-down (matrix '(2 3) '(2 1 2 0 1 0)))
                    (spread-plot (matrix '(2 2) (list tour-plot 
                                                      (list var-list obs-list ) 
                                                      nil nil))
                                 :span-down (matrix '(2 2) '(2 2 0 0))
                                 :rel-widths '(2 .5 ))))
         )  
    (send *watcher* :write-text "Creating Custom Methods" :show t)
  ;  (send splot :show-spreadplot)
    (setf *current-spreadplot* splot)
    (defmeth splot :spreadplot-help ()
      (send tour-plot :plot-help))
    (send tour-plot :spreadplot splot)
    (send self :plot-objs 
          (list tour-plot target1 target2 obs-list var-list)) 
        
    (setf basic-size (send self :make-basic-window-size targets list-width))
    (setf basic-height (- basic-size window-decoration-height))
    (setf basic-width  
          (- basic-size 4 border-thickness window-decoration-width));4
    (send self :basic-width basic-width)
    (send self :basic-height basic-height)
    (send self :list-width list-width)
    (send self :targets targets)
    
    (send tour-plot :point-label 
          (iseq (send tour-plot :num-points))
          point-labels)
    (send tour-plot :model-p model-p)
    (send tour-plot :new-menu "TourPlot" 
        :items '(SHOWING-LABELS MOUSE RESIZE-BRUSH SLICER DASH
                 ERASE-SELECTION FOCUS-ON-SELECTION SHOW-ALL SYMBOL 
                 COLOR SELECTION DASH FASTER SLOWER CUING AXES REVERSE
                 ))
    (send *show-targets-menu-item* :mark targets)
    (send tour-plot :transformation nil)
    (send tour-plot :tour-alg)
    (send tour-plot :scale-type 'centroid-variable)
    (send tour-plot :linked t)
    (send tour-plot   :point-symbol
          (iseq (send tour-plot :num-points)) 'square)
    (send tour-plot :point-color (iseq (send tour-plot :num-points)) 'blue)
    (send tour-plot :showing-labels t)
    
    (defmeth tour-plot :plot-help ()
      (plot-help-window (strcat "Help for " (send self :title)))
      (paste-plot-help (format nil "TOUR CONTROLS~2%The Guided Tour window presents a spinning 6-dimensional scatterplot. Initially, the space corresponds to the first 6 variables in your data, and it is spinning in the 3D space defined by the first 3 variables. ~2%"))
      (paste-plot-help (format nil "High-dimensional rotation is called a 'tour' of high-dimensional space. The tour is initiated by clicking on the TOUR button. The speed of the tour is controlled by the HSpd and VSpd buttons, which control the speed of rotation of the cloud in the Horizontal and Vertical directions. The minimum speed is zero. Holding down these buttons gradually increases the speed. Note that when the cloud is spinning both horizontally and vertically, the result is a four-dimensional tour which appears as moving points, not as rotation.~2%"))
      (paste-plot-help (format nil "The beginning position of the point cloud is the same as that shown in the First Target window. When the horizontal and vertical dimensions are rotated 270 degrees the position is the same as that shown in the Second Target window. Further rotation by 90 degrees brings the cloud back to the First Target position.~2%"))
      (paste-plot-help (format nil "The NEW button creates a new 6 dimensional space for a new tour. It does this by using the 3 dimensions of the current position shown in the window as the new 'First Target', and by defining the highest variance 3-dimensional space which is orthogonal to the new First Target as being a new Second Target.~2%"))
      (paste-plot-help (format nil "SPIN CONTROLS~2%The description given in this section is from the general help about spinning plots.  The description also applies to the tour plot, except that the HOME and ROCK buttons have been redefined to work within a six-dimensional context.~2%")) 
      (call-next-method :flush nil)
      (when (send splot :targets)
            (paste-plot-help (format nil "~2%TARGETS~2%"))
            (send target1 :plot-help t)
            (send target2 :plot-help t))
      (show-plot-help)
      )

    (send target1 :new-menu "Target1" 
          :items '(SHOWING-LABELS MOUSE RESIZE-BRUSH SLICER DASH
                   ERASE-SELECTION FOCUS-ON-SELECTION SHOW-ALL SYMBOL 
                   COLOR SELECTION DASH FASTER SLOWER CUING AXES REVERSE))
    (send target1 :content-variables 0 1 2)
    (send target1 :adjust-to-data)
    (send target1 :idle-on nil)
    (send target1 :transformation nil)
    (send target1 :scale-type 'centroid-variable)
    (send target1 :linked t)
   ; (send target1 :depth-cuing nil)
    (send target1   :point-symbol
          (iseq (send target1 :num-points)) 'square)
   ; (send target1 :use-color t)
    (send target1 :point-color (iseq (send target1 :num-points)) 'blue)
    (send target1 :showing-labels t)
   ; (send target1 :mouse-mode 'brushing)
    ;(send target1 :set-variables-with-labels '(0 1 2)
    ;      (select (send target1 :variable-labels) '(0 1 2))) 
    ;(send target1 :plot-buttons :margin nil :new-z t)
    (defmeth target1 :plot-help (&optional w)
      (unless w (plot-help-window (strcat "Help for " (send self :title))))
      (paste-plot-help (format nil "The First Target plot is an ordinary spinning 3-dimensional scatterplot. It serves as one of the two targets defining the tour shown in the Guided Tour window. Initially, this space shows the first three variables in your data. The beginning position of the point cloud serves as the HOME position for the tour. The position of the point cloud is redefined to be that in the Guided Tour window when the tour plot's NEW button is used.~2%"))
      (unless w (show-plot-help)
              (call-next-method :flush nil)))
        
    (send target2 :new-menu "Target2" 
          :items '(SHOWING-LABELS MOUSE RESIZE-BRUSH SLICER DASH
                   ERASE-SELECTION FOCUS-ON-SELECTION SHOW-ALL SYMBOL 
                   COLOR SELECTION DASH FASTER SLOWER CUING AXES REVERSE))
    (send target2 :content-variables 3 4 5)
    (send target2 :idle-on nil)
    (send target2 :transformation nil)
    (send target2 :scale-type 'centroid-variable)
    (send target2 :linked t)
  ;  (send target2 :depth-cuing nil)
    (send target2   :point-symbol
          (iseq (send target2 :num-points)) 'square)
   ; (send target2 :use-color t)
    (send target2 :point-color (iseq (send target2 :num-points)) 'blue)
    (send target2 :showing-labels t)
   ; (send target2 :mouse-mode 'brushing)
    (send target2 :set-variables-with-labels '(3 4 5)
          (select (send target2 :variable-labels) '(3 4 5))) 
  ;  (send target2 :plot-buttons :margin nil :new-z t)
    (defmeth target2 :plot-help (&optional w)
      (unless w (plot-help-window (strcat "Help for " (send self :title))))
      (paste-plot-help (format nil "The Second Target plot is an ordinary spinning 3-dimensional scatterplot. It serves as one of the two targets defining the tour shown in the Guided Tour window. Initially, this space corresponds to the 4th, 5th and 6th variables in your data. The Second Target point cloud is the maximum variance cloud which is orthogonal to the First Target point cloud. The position of the point cloud is redefined when the Guided Tour window's NEW button is used so that it continues to be the highest variance space which is orthogonal to the First Target cloud.~2%"))
      (unless w (show-plot-help)
              (call-next-method :flush nil)))
    (send obs-list :fix-name-list)
    (send var-list :fix-name-list)
    ;(send obs-list :has-h-scroll (max (screen-size)))
    ;(send obs-list :has-v-scroll (max (screen-size)))
    (defmeth obs-list :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil "The Obs window provides a window for displaying and interacting with lists of observation names. When you select items in this window you will highlight and label points in the spinnable plots. You can select items in this window by clicking on an item, by shift-clicking on several items, or by dragging your cursor over the items."))
      (show-plot-help))

    ;(send var-list :has-h-scroll (max (screen-size)))
    ;(send var-list :has-v-scroll (max (screen-size)))
    (defmeth var-list :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil "The Var window provides a window for displaying and interacting with lists of variable names. When you select items in this window you will change the variables that form the basis of the guided tour. You can select items in this window by clicking on an item, by shift-clicking on several items, or by dragging your cursor over the items.~2% Currently, this window does not correctly interact with the other windows."))
      (show-plot-help))

        (defmeth var-list :do-select-click (x y m1 m2)
            (call-next-method x y m1 m2)
            (let* ((sel-var (send self :selection))
                   (nvar (send self :num-points))
                   (nobs (send tour-plot :num-points))
                   (variable-labels (send self :point-label (iseq nvar)))
                   )
              (when (> (length sel-var) 5)
                    (when (> (length sel-var) 6)
                          (setf sel-var (select sel-var (iseq 6))))
                    (let ((lo-var (select sel-var (iseq 3)))
                          (hi-var (select sel-var (iseq 3 5)))
                          )
                      (send tour-plot :tour-variables sel-var)
                      (send tour-plot :set-variables-with-labels sel-var
                         (select (send tour-plot :variable-labels) sel-var))
                      (apply #'send tour-plot :current-variables lo-var)
                      (apply #'send target1 :current-variables lo-var)
                      (send target1 :set-variables-with-labels lo-var
                            (select (send target1 :variable-labels) lo-var))
                      (apply #'send target2 :current-variables hi-var)
                      (send target2 :set-variables-with-labels hi-var
                            (select (send target2 :variable-labels) hi-var))
                      (send tour-plot :redraw-content)
                      (send target1 :redraw-content)
                      (send target2 :redraw-content)
                    ))))
          
    (send tour-plot :linked t)
    (send target1   :linked t)
    (send target2   :linked t)
    (send obs-list  :linked t)
    (when model-p  
        (send current-model :create-ingram-plots
              permuted-variables point-labels
                    permuted-variable-labels))
    (defmeth tour-plot :close ()
      (setf *current-spreadplot* nil)
      (send command-menu-refresh-spreadplot-item :enabled nil)
      (mapcar #'(lambda (plot) (send plot :remove)) (send splot :plot-objs))
      (when (equal *current-object* *current-data*)
        (send *vista*   :show-labels)
        (send *vista* :show-obs))
      )
    (send tour-plot :initial-tour)
    (send splot :show-spreadplot)
    (setf *current-spreadplot* self)
    (send command-menu-refresh-spreadplot-item :enabled t)
    (setf *current-spreadplot* splot)
   ; (send tour-plot :stop-go)
    ))

(defmeth tour-spreadplot-proto :make-basic-window-size 
           (targets list-width)
      (cond 
        (targets
         (setf ntimes 3)
         (setf max-size (max (min screen-size) 
                             (max (- screen-size list-width)))))
        (t
         (setf ntimes 2)
         (setf max-size (min screen-size))))
      (floor (/ max-size ntimes)))

(defmeth tour-spreadplot-proto :layout-plots ()
  (let* ((plots (send self :plot-objs))
         (tour-plot (first plots))
         (target1   (second plots))
         (target2   (third plots))
         (obs-list  (fourth plots))
         (var-list  (fifth plots))
         (list-width (send self :list-width))
         (targets (send self :targets))
         (ntimes (if targets 3 2))
         (basic-size (send self :make-basic-window-size targets list-width))
         (basic-height (- basic-size window-decoration-height msdos-fiddle))
         (basic-width  
          (- basic-size border-thickness window-decoration-width msdos-fiddle))
         )
    (send self :basic-width basic-width)
    (send self :basic-height basic-height)
    (send tour-plot :size 
          (+ (* 2 basic-width) msdos-fiddle window-decoration-width)
          (+ 3 (* 2 basic-height) msdos-fiddle))
    (send tour-plot :location (first location11) 
          (+ (- (second location11) menu-bar-height)
             border-thickness window-decoration-height msdos-fiddle))
    (send target1 :size 
          (+ basic-width (/ window-decoration-width 2))
          (- basic-height border-thickness (/ window-decoration-height 2)))
    (send target1 :location
          (+ (first location11) window-decoration-width 
             (* 2 (+ basic-width border-thickness)) msdos-fiddle)
          (+ (- (second location11) menu-bar-height) 
             border-thickness window-decoration-height msdos-fiddle))
    (send target2 :size 
          (+ basic-width (/ window-decoration-width 2))
          (- basic-height border-thickness (/ window-decoration-height 2)))
    (send target2 :location
          (+ (first location11) window-decoration-width 
             (* 2 (+ basic-width border-thickness)) msdos-fiddle)
          (- (+ (second location11) basic-height (* 3 msdos-fiddle )
                (* 3 border-thickness))
             (/ window-decoration-height 2)))
    (send obs-list :location
          (+ (first location11) msdos-fiddle 
             (if targets (* 4 border-thickness) (* 2 border-thickness))
             (* 1/2 ntimes window-decoration-width) (* ntimes basic-width))
          (+ (- (second location11) menu-bar-height)
             border-thickness window-decoration-height msdos-fiddle))
    (send obs-list :size list-width
          (if targets 
              (- basic-height border-thickness 
                      (/ window-decoration-height 2))
              (+ 3 (* 2 basic-height) msdos-fiddle)
              ))

    (send var-list :location
          (if targets
              (+ (first location11) msdos-fiddle 
                 (* 4 border-thickness)
                 (* 1/2 ntimes window-decoration-width) 
                 (* ntimes basic-width))
              (+ (first location11) (* 2 msdos-fiddle) list-width 
                 (* 3 border-thickness)
                 (* 1/2 ntimes window-decoration-width) 
                 (* ntimes basic-width))
              )
          (if targets
             (- (+ (second location11) basic-height (* 3 msdos-fiddle )
                   (* 3 border-thickness))
                (/ window-decoration-height 2))
             (+ (- (second location11) menu-bar-height)
                border-thickness window-decoration-height msdos-fiddle)
           ))
    (send var-list :size list-width 
          (if targets 
              (- basic-height border-thickness 
                      (/ window-decoration-height 2))
              (+ 3 (* 2 basic-height) msdos-fiddle)
              ))
    ))

(defmeth tour-spreadplot-proto :refresh-spreadplot ()
  (let* ((plots (send self :plot-objs))
         (tour-plot (first plots))
         (target1   (second plots))
         (target2   (third plots))
         (obs-list  (fourth plots))
         (var-list  (fifth plots))
         (targets (send *show-targets-menu-item* :mark)))
    (send self :targets targets)
#+macintosh    (mapcar #'(lambda (plot) (send plot :hide-window))
                       (send self :plot-objs))
#-macintosh(when (not targets)
                 (send target1 :hide-window)
                 (send target2 :hide-window))
    (send self :layout-plots)
   ; (send tour-plot :show-window)
    (when targets
          (send target1 :show-window)
          (send target2 :show-window))
    (send obs-list :show-window)
    (send var-list :show-window)
    (send tour-plot :show-window)
    ))

(defmeth tour-spreadplot-proto :new-home 
  (nvar nobs tour-var variable-labels model-p)
"Args: (nvar nobs tour-var variable-labels)
Used by scattterplot matrix do-variable-focus method with visuals spreadplot to create a new home set of variables for the grand tour.  Nvar and nobs are number of variables and observations in the tour. Tour-var is a list of the new home variables. Variable-labels is a list of the variable labels."
  (dotimes (i nvar)
           (send self :point-coordinate i (iseq nobs)
                 (send scatmat :point-coordinate 
                       (select tour-var i) (iseq nobs)))
           (send target1   :point-coordinate i (iseq nobs)
                 (send scatmat :point-coordinate 
                       (select tour-var i) (iseq nobs)))
           (send target2   :point-coordinate i (iseq nobs)
                 (send scatmat :point-coordinate 
                       (select tour-var i) (iseq nobs))))
  (send tour-plot :variable-label  (iseq nvar)
        (select variable-labels tour-var))
  (send target1   :variable-label (iseq nvar) 
        (select variable-labels tour-var))
  (send target2   :variable-label (iseq nvar) 
        (select variable-labels tour-var))
  (if model-p (send current-model :update-ingram-plots
                    nvar nobs tour-var variable-labels))
  (send tour-plot :home)
  )

;(provide "visuals")